home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 March / EnigmA AMIGA RUN 05 (1996)(G.R. Edizioni)(IT)[!][issue 1996-03][Skylink CD IV].iso / earcd / program / mui32dev.lha / MUI / Developer / Modula / Demo / Class3.mod < prev    next >
Text File  |  1995-11-18  |  11KB  |  347 lines
  1. MODULE Class3 ;
  2.  
  3. (*
  4. ** Class3.mod by Olaf "Olf" Peters <olf@informatik.uni-bremen.de>
  5. **
  6. ** based upon Class3.c by Stefan Stuntz.
  7. *)
  8.  
  9. (*$ RangeChk := FALSE *)
  10.  
  11. FROM SYSTEM     IMPORT  TAG, ADR, ADDRESS, LONGSET, CAST, SETREG, REG ;
  12. FROM AmigaLib   IMPORT  DoSuperMethodA ;
  13. FROM ExecL      IMPORT  Wait ;
  14.  
  15. IMPORT
  16.         R,
  17.         gd  : GraphicsD,
  18.         gl  : GraphicsL,
  19.         id  : IntuitionD,
  20.         il  : IntuitionL,
  21.         m   : MuiD,
  22.         mc  : MuiClasses,
  23.         ml  : MuiL,
  24.         mm  : MuiMacros,
  25.         ms  : MuiSupport,
  26.         ud  : UtilityD,
  27.         ul  : UtilityL ;
  28.  
  29. (***************************************************************************)
  30. (* Here is the beginning of our new class...                               *)
  31. (***************************************************************************)
  32.  
  33. (*
  34. ** This is the instance data for our custom class.
  35. *)
  36.  
  37. TYPE
  38.   Data  = RECORD
  39.             x,
  40.             y,
  41.             sx,
  42.             sy : INTEGER ;
  43.           END (* RECORD *) ;
  44.  
  45. (*
  46. ** AskMinMax method will be called before the window is opened
  47. ** and before layout takes place. We need to tell MUI the
  48. ** minimum, maximum and default size of our object.
  49. *)
  50.  
  51. (*/// "mAskMinMax(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpAskMinMaxPtr) : ADDRES" *)
  52.  
  53. PROCEDURE mAskMinMax(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpAskMinMaxPtr) : ADDRESS;
  54.  
  55. BEGIN
  56.   (*
  57.   ** let our superclass first fill in what it thinks about sizes.
  58.   ** this will e.g. add the size of frame and inner spacing.
  59.   *)
  60.  
  61.   IF DoSuperMethodA(cl, obj, msg) # NIL THEN END ;
  62.  
  63.   (*
  64.   ** now add the values specific to our object. note that we
  65.   ** indeed need to *add* these values, not just set them!
  66.   *)
  67.  
  68.   INC(msg^.MinMaxInfo^.MinWidth, 100) ;
  69.   INC(msg^.MinMaxInfo^.DefWidth, 120) ;
  70.   INC(msg^.MinMaxInfo^.MaxWidth, 500) ;
  71.  
  72.   INC(msg^.MinMaxInfo^.MinHeight, 40) ;
  73.   INC(msg^.MinMaxInfo^.DefHeight, 90) ;
  74.   INC(msg^.MinMaxInfo^.MaxHeight, 300) ;
  75.  
  76.   RETURN NIL ;
  77. END mAskMinMax ;
  78.  
  79. (*\\\*)
  80.  
  81. (*
  82. ** Draw method is called whenever MUI feels we should render
  83. ** our object. This usually happens after layout is finished
  84. ** or when we need to refresh in a simplerefresh window.
  85. ** Note: You may only render within the rectangle
  86. **       _mleft(obj), _mtop(obj), _mwidth(obj), _mheight(obj).
  87. *)
  88.  
  89. (*/// "mDraw(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpDrawPtr) : ADDRES" *)
  90.  
  91. PROCEDURE mDraw(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpDrawPtr) : ADDRESS;
  92.  
  93. VAR
  94.   data : POINTER TO Data ;
  95.  
  96. BEGIN
  97.   data := mc.InstData(cl, obj) ;
  98.  
  99.   (*
  100.   ** let our superclass draw itself first, area class would
  101.   ** e.g. draw the frame and clear the whole region. What
  102.   ** it does exactly depends on msg->flags.
  103.   **
  104.   ** Note: You *must* call the super method prior to do
  105.   ** anything else, otherwise msg->flags will not be set
  106.   ** properly !!!
  107.   *)
  108.  
  109.   IF DoSuperMethodA(cl, obj, msg) # NIL THEN END ;
  110.  
  111.   (*
  112.   ** if MADF_DRAWOBJECT isn't set, we shouldn't draw anything.
  113.   ** MUI just wanted to update the frame or something like that.
  114.   *)
  115.  
  116.   IF mc.drawUpdate IN msg^.flags THEN
  117.     IF (data^.sx # 0) OR (data^.sy # 0) THEN
  118.       gl.SetBPen(mc.OBJ_rp(obj),mc.OBJ_dri(obj)^.pens^[id.shinePen]) ;
  119.       gl.ScrollRaster(mc.OBJ_rp(obj),data^.sx,data^.sy,mc.OBJ_mleft(obj),mc.OBJ_mtop(obj),mc.OBJ_mright(obj),mc.OBJ_mbottom(obj));
  120.       gl.SetBPen(mc.OBJ_rp(obj),0);
  121.       data^.sx := 0;
  122.       data^.sy := 0;
  123.     ELSE
  124.       gl.SetAPen(mc.OBJ_rp(obj),mc.OBJ_dri(obj)^.pens^[id.shadowPen]);
  125.       IF gl.WritePixel(mc.OBJ_rp(obj),data^.x,data^.y) THEN END ;
  126.     END (* IF *) ;
  127.   ELSIF mc.drawObject IN msg^.flags THEN
  128.     gl.SetAPen(mc.OBJ_rp(obj),mc.OBJ_dri(obj)^.pens^[id.shinePen]);
  129.     gl.RectFill(mc.OBJ_rp(obj),mc.OBJ_mleft(obj),mc.OBJ_mtop(obj),mc.OBJ_mright(obj),mc.OBJ_mbottom(obj));
  130.   END (* IF *) ;
  131.  
  132.   RETURN NIL ;
  133. END mDraw ;
  134.  
  135. (*\\\*)
  136. (*/// "mSetup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRES" *)
  137.  
  138. PROCEDURE mSetup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRESS;
  139.  
  140. BEGIN
  141.   IF DoSuperMethodA(cl, obj, msg) = NIL THEN RETURN LONGINT(FALSE) END ;
  142.  
  143.   ml.moRequestIDCMP(obj,id.IDCMPFlagSet{id.mouseButtons, id.rawKey}) ;
  144.   RETURN LONGINT(TRUE) ;
  145. END mSetup ;
  146.  
  147. (*\\\*)
  148. (*/// "mCleanup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRES" *)
  149.  
  150. PROCEDURE mCleanup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRESS;
  151.  
  152. BEGIN
  153.   ml.moRejectIDCMP(obj,id.IDCMPFlagSet{id.mouseButtons, id.rawKey}) ;
  154.  
  155.   RETURN DoSuperMethodA(cl, obj, msg) ;
  156. END mCleanup;
  157.  
  158. (*\\\*)
  159. (*/// "mHandleInput(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRES" *)
  160.  
  161. PROCEDURE mHandleInput(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRESS;
  162.  
  163.   PROCEDURE Between(a, x, b : LONGINT) : BOOLEAN ;
  164.   BEGIN
  165.     RETURN (x >= a) AND (x <= b) ;
  166.   END Between ;
  167.  
  168.   PROCEDURE IsInObject(x, y : LONGINT) : BOOLEAN ;
  169.   BEGIN
  170.     RETURN Between(mc.OBJ_mleft(obj), x, mc.OBJ_mright(obj)) AND Between(mc.OBJ_mtop(obj), y, mc.OBJ_mbottom(obj)) ;
  171.   END IsInObject;
  172.  
  173. VAR
  174.   data : POINTER TO Data ;
  175.  
  176. BEGIN
  177.   data := mc.InstData(cl, obj) ;
  178.  
  179.   IF msg^.muikey # 0 THEN
  180.     CASE msg^.muikey OF
  181.     | mc.MUIKEYLEFT  : data^.sx := -1 ; IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  182.     | mc.MUIKEYRIGHT : data^.sx :=  1 ; IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  183.     | mc.MUIKEYUP    : data^.sy := -1 ; IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  184.     | mc.MUIKEYDOWN  : data^.sy :=  1 ; IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  185.     ELSE
  186.     END (* CASE *) ;
  187.   END (* IF *) ;
  188.  
  189.   IF msg^.imsg # NIL THEN
  190.     IF id.mouseButtons IN msg^.imsg^.class THEN
  191.       IF msg^.imsg^.code = id.selectDown THEN
  192.         IF IsInObject(msg^.imsg^.mouseX, msg^.imsg^.mouseY) THEN
  193.           data^.x := msg^.imsg^.mouseX ;
  194.           data^.y := msg^.imsg^.mouseY ;
  195.           IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  196.           ml.moRequestIDCMP(obj, id.IDCMPFlagSet{id.mouseMove}) ;
  197.         END (* IF *) ;
  198.       ELSE
  199.         ml.moRejectIDCMP(obj, id.IDCMPFlagSet{id.mouseMove}) ;
  200.       END (* IF *) ;
  201.     ELSIF id.mouseMove IN msg^.imsg^.class THEN
  202.       IF IsInObject(msg^.imsg^.mouseX, msg^.imsg^.mouseY) THEN
  203.         data^.x := msg^.imsg^.mouseX ;
  204.         data^.y := msg^.imsg^.mouseY ;
  205.         IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  206.       END (* IF *) ;
  207.     END (* IF *)
  208.   END (* IF *) ;
  209.  
  210.   RETURN DoSuperMethodA(cl, obj, msg) ;
  211. END mHandleInput ;
  212.  
  213. (*\\\*)
  214.  
  215. (*
  216. ** Here comes the dispatcher for our custom class. 
  217. ** Unknown/unused methods are passed to the superclass immediately.
  218. *)
  219.  
  220. (*/// "MyDispatcher(cl : id.IClassPtr; obj : ADDRESS; msg : ADDRESS) : ADDRESS" *)
  221.  
  222. PROCEDURE MyDispatcher(cl : id.IClassPtr; obj : ADDRESS; msg : ADDRESS) : ADDRESS ;
  223.  
  224. VAR
  225.   mid : LONGCARD ;
  226.  
  227. BEGIN
  228.   mid := CAST(id.Msg, msg)^.methodID ;
  229.  
  230.      IF mid = m.mmAskMinMax   THEN RETURN mAskMinMax(cl, obj, msg)
  231.   ELSIF mid = m.mmSetup       THEN RETURN mSetup(cl, obj, msg)
  232.   ELSIF mid = m.mmCleanup     THEN RETURN mCleanup(cl, obj, msg)
  233.   ELSIF mid = m.mmDraw        THEN RETURN mDraw(cl, obj, msg)
  234.   ELSIF mid = m.mmHandleInput THEN RETURN mHandleInput(cl, obj, msg)
  235.   ELSE
  236.     RETURN DoSuperMethodA(cl, obj, msg)
  237.   END (* CASE *) ;
  238. END MyDispatcher ;
  239.  
  240. (*\\\*)
  241.  
  242. (***************************************************************************)
  243. (* Thats all there is about it. Now lets see how things are used...        *)
  244. (***************************************************************************)
  245.  
  246. VAR
  247.   app,
  248.   window,
  249.   grp,
  250.   myObj,
  251.   text     :  id.ObjectPtr ;
  252.   mcc      :  mc.mCustomClassPtr ;
  253.   signals  :  LONGSET ;
  254.   running  := BOOLEAN{TRUE} ;
  255.   myDispatcher : ADDRESS ;
  256.   NULL     := ADDRESS{NIL} ;
  257.  
  258.   tags     :  ARRAY [0..31] OF LONGINT ;
  259.  
  260. BEGIN
  261.  
  262.   (* Create the new custom class with a call to MUI_CreateCustomClass(). *)
  263.   (* Caution: This function returns not a struct IClass, but a           *)
  264.   (* struct MUI_CustomClass which contains a struct IClass to be         *)
  265.   (* used with NewObject() calls.                                        *)
  266.   (* Note well: MUI creates the dispatcher hook for you, you may         *)
  267.   (* *not* use its h_Data field! If you need custom data, use the        *)
  268.   (* cl_UserData of the IClass structure!                                *)
  269.  
  270.   IF ml.muiMasterVersion < 11 THEN ms.fail(NULL, "You need MUI 3 to run this demo.") END;
  271.  
  272.   myDispatcher := ADR(MyDispatcher) ;
  273.   mcc := ml.moCreateCustomClass(NIL, ADR(m.mcArea), NIL, SIZE(Data), myDispatcher) ;
  274.   IF mcc = NIL THEN ms.fail(NULL, "Could not create custom class.") END ;
  275.  
  276.   mc.MakeDispatcher(MyDispatcher, mcc^.class) ;
  277.  
  278.   myObj := il.NewObjectA(mcc^.class, NIL, TAG(tags, m.maFrame,       m.mvFrameText,
  279.                                               ud.tagDone)) ;
  280.  
  281.   text := mm.TextObject(TAG(tags, m.maFrame,        m.mvFrameText,
  282.                                   m.maBackground,   m.miTextBack,
  283.                                   m.maTextContents, ADR("\ecPaint with mouse,\nscroll with cursor keys."),
  284.                             ud.tagDone)) ;
  285.  
  286.   grp := mm.GroupObject(TAG(tags, m.maGroupHoriz, FALSE,
  287.                                   mm.Child,       text,
  288.                                   mm.Child,       myObj,
  289.                             ud.tagDone)) ;
  290.  
  291.  
  292.   window := mm.WindowObject(TAG(tags, m.maWindowTitle, ADR("A rather complex custom class"),
  293.                                       m.maWindowID,    mm.MakeID("CLS3"),
  294.                                       mm.WindowContents, grp,
  295.                                 ud.tagDone)) ;
  296.  
  297.   app := mm.ApplicationObject(TAG(tags, m.maApplicationTitle,       ADR("Class3-M2"),
  298.                                         m.maApplicationVersion,     ADR("$VER: Class3-M2 11.1 (22.9.95)"),
  299.                                         m.maApplicationCopyright,   ADR("©1995, Olaf Peters, Stefan Stuntz"),
  300.                                         m.maApplicationAuthor,      ADR("Olaf Peters, Stefan Stuntz"),
  301.                                         m.maApplicationDescription, ADR("Demonstrate the use of custom classes."),
  302.                                         m.maApplicationBase,        ADR("CLASS3M2"),
  303.                                         mm.SubWindow,               window,
  304.                                   ud.tagDone)) ;
  305.  
  306.   IF app = NIL THEN ms.fail(NULL, "Failed to create Application.") END ;
  307.  
  308.   mm.set(window,m.maWindowDefaultObject, LONGCARD(myObj)) ;
  309.  
  310.   mm.NoteClose(app, window, m.mvApplicationReturnIDQuit) ; 
  311.  
  312.  
  313. (*
  314. ** Input loop...
  315. *)
  316.  
  317.   mm.set(window, m.maWindowOpen, LONGCARD(TRUE)) ;
  318.  
  319.   WHILE running DO
  320.     CASE ms.DOMethod(app, TAG(tags, m.mmApplicationInput, ADR(signals), ud.tagDone)) OF
  321.     | m.mvApplicationReturnIDQuit : running := FALSE ;
  322.     ELSE
  323.     END (* CASE *) ;
  324.     IF running AND (signals # LONGSET{}) THEN
  325.       signals := Wait(signals) ;
  326.     END (* IF *) ;
  327.   END (* WHILE *) ;
  328.  
  329.   mm.set(window, m.maWindowOpen, LONGCARD(FALSE)) ;
  330.  
  331.  
  332. (*
  333. ** Shut down...
  334. *)
  335.  
  336. CLOSE
  337.   IF app # NIL THEN
  338.     ml.mDisposeObject(app) ;
  339.     app := NIL ;
  340.   END (* IF *) ;
  341.  
  342.   IF mcc # NIL THEN
  343.     IF ml.moDeleteCustomClass(mcc) THEN END ;
  344.     mcc := NIL ;
  345.   END (* IF *) ;
  346. END Class3.
  347.